home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0085_Component simulates a Luffing Switch.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  13.5 KB  |  383 lines
  1. {
  2.   Programm : SWITCH.PAS
  3.   Sprache  : Delphi
  4.   Zweck    : Schalter-Komponente
  5.   Datum    : 15, 16. Feb. 1996
  6.   Autor    : U.Jnr-
  7.  
  8.   This component simulates a luffing switch as used in many electic devices.
  9.   No Bitmaps are used, so it's fully scaleable.
  10.  
  11.   Sorry for comments are in german.
  12.  
  13.   Contact: Udo Juerss, 57078 Siegen, Germany, CompuServe [101364,526]
  14.  
  15.   Greetings from germany - enjoy...
  16. }
  17.  
  18. unit
  19.   Switch;
  20.  
  21. interface
  22.  
  23. uses
  24.   WinTypes, WinProcs, Messages, Classes, Controls, Graphics;
  25. {------------------------------------------------------------------------------}
  26.  
  27. type
  28.   RectArray = array[0..3] of TPoint;               {Vektorarraytyp fnr Rechteck}
  29.   TriArray = array[0..2] of TPoint;                 {Vektorarraytyp fnr Dreieck}
  30.  
  31.   TSwitch = class(TCustomControl)
  32.   private
  33.     TopShape: TriArray;                 {Dreieck Vektoren von Schalteroberseite}
  34.     OnShape: RectArray;               {Rechteck Vektoren von Schalterfront "ON"}
  35.     OffShape: RectArray;             {Rechteck Vektoren von Schalterfront "OFF"}
  36.     SideShape: RectArray;                  {Rechteck Vektoren von Schalterseite}
  37.  
  38.     FOnChanged: TNotifyEvent;                        {Verbindung zur Aussenwelt}
  39.     FOnChecked: TNotifyEvent;                        {Verbindung zur Aussenwelt}
  40.     FOnUnChecked: TNotifyEvent;                      {Verbindung zur Aussenwelt}
  41.  
  42.     FCaptionOn: TCaption;                   {Beschriftung Schalterstellung "ON"}
  43.     FCaptionOff: TCaption;                 {Beschriftung Schalterstellung "OFF"}
  44.     FChecked: Boolean;                               {Flag von Schalterstellung}
  45.     FCheckedLeft: Boolean;     {Flag ob "ON" links oder rechts dargestellt wird}
  46.     FSlope: Byte;                            {Neigung (3D Effekt) des Schalters}
  47.     FSideLength: Byte;          {Seitenabstand fnr hervorstehendes Schalterteil}
  48.     FOnColor: TColor;                               {Farbe fnr Frontfl_che "ON"}
  49.     FOffColor: TColor;                             {Farbe fnr Frontfl_che "OFF"}
  50.     FTopColor: TColor;                             {Farbe fnr Schalteroberseite}
  51.     FSideColor: TColor;                                 {Farbe fnr Seitenfl_che}
  52.     ALeft: Integer;                        {Linke Anfangsposition des Schalters}
  53.     ATop: Integer;                         {Obere Anfangsposition des Schalters}
  54.     AHeight: Integer;                                       {Hwhe des Schalters}
  55.     AWidth: Integer;                                      {Breite des Schalters}
  56.     LabelLen: Integer;                                {Halbbreite des Schalters}
  57.     LabelOfs: Integer;                       {Halbbreite fnr Spiegeldarstellung}
  58.     Side: Integer;                                 {Tempor_r in Setup verwendet}
  59.  
  60.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  61.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  62.     procedure CallNotifyEvent;
  63.     procedure Setup;
  64.     procedure Draw;
  65.     procedure SetCaptionOn(Value: TCaption);
  66.     procedure SetCaptionOff(Value: TCaption);
  67.     procedure SetChecked(Value: Boolean);
  68.     procedure SetCheckedLeft(Value: Boolean);
  69.     procedure SetSlope(Value: Byte);
  70.     procedure SetSideLength(Value: Byte);
  71.     procedure SetOnColor(Value: TColor);
  72.     procedure SetOffColor(Value: TColor);
  73.     procedure SetTopColor(Value: TColor);
  74.     procedure SetSideColor(Value: TColor);
  75.   public
  76.     constructor Create(AOwner: TComponent); override;
  77.     procedure Paint; override;
  78.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  79.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  80.   published
  81.     property CaptionOn: TCaption read FCaptionOn write SetCaptionOn;
  82.     property CaptionOff: TCaption read FCaptionOff write SetCaptionOff;
  83.     property Checked: Boolean read FChecked write SetChecked default False;
  84.     property CheckedLeft: Boolean read FCheckedLeft write SetCheckedLeft default True;
  85.     property Slope: Byte read FSlope write SetSlope default 6;
  86.     property SideLength: Byte read FSideLength write SetSideLength default 6;
  87.     property OnColor: TColor read FOnColor write SetOnColor default clRed;
  88.     property OffColor: TColor read FOffColor write SetOffColor default clMaroon;
  89.     property TopColor: TColor read FTopColor write SetTopColor default clSilver;
  90.     property SideColor: TColor read FSideColor write SetSideColor default clSilver;
  91.     property Font;
  92.     property TabStop;
  93.     property TabOrder;
  94.     property ShowHint;
  95.  
  96.     property OnClick;
  97.     property OnMouseDown;
  98.     property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  99.     property OnChecked: TNotifyEvent read FOnChecked write FOnChecked;
  100.     property OnUnChecked: TNotifyEvent read FOnUnChecked write FOnUnChecked;
  101.   end;
  102. {------------------------------------------------------------------------------}
  103.  
  104. procedure Register;
  105.  
  106. implementation
  107. {------------------------------------------------------------------------------}
  108.  
  109. constructor TSwitch.Create(AOwner: TComponent);
  110. begin
  111.   inherited Create(AOwner);
  112.   Caption:='';
  113.   FCaptionOn:='EIN';
  114.   FCaptionOff:='AUS';
  115.   FSlope:=6;
  116.   FSideLength:=6;
  117.   FChecked:=False;
  118.   FCheckedLeft:=True;
  119.   FOnColor:=clRed;
  120.   FOffColor:=clMaroon;
  121.   FTopColor:=clSilver;
  122.   FSideColor:=clSilver;
  123.   FOnChecked:=nil;
  124.   FOnUnChecked:=nil;
  125.   SetBounds(Left,Top,83,18 + FSlope);
  126.   Font.Name:='small fonts';
  127.   Font.Size:=7;
  128.   Font.Color:=clWhite;
  129. end;
  130. {------------------------------------------------------------------------------}
  131.  
  132. procedure TSwitch.Paint;
  133. begin
  134.   Draw;            {Keine geerbte Methode aufrufen und sofort Schalter zeichnen}
  135. end;
  136. {------------------------------------------------------------------------------}
  137.  
  138. procedure TSwitch.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  139. begin
  140.   inherited MouseDown(Button,Shift,X,Y);
  141.   if (Button = mbLeft) then
  142.   begin
  143.     SetFocus;
  144.     if ((LabelLen > 0) and (X > LabelLen)) or
  145.        ((LabelLen < 0) and (X < Abs(LabelLen))) then
  146.     begin    {Nur wenn Mausklick innerhalb des hervorgehobenen Schalterteil ist}
  147.       FChecked:=not FChecked;
  148.       CallNotifyEvent;
  149.       Invalidate;
  150.     end;
  151.   end;
  152. end;
  153. {------------------------------------------------------------------------------}
  154.  
  155. procedure TSwitch.WMSetFocus(var Message: TWMSetFocus);
  156. begin
  157.   Invalidate;
  158. end;
  159. {------------------------------------------------------------------------------}
  160.  
  161. procedure TSwitch.WMKillFocus(var Message: TWMKillFocus);
  162. begin
  163.   Invalidate;
  164. end;
  165. {------------------------------------------------------------------------------}
  166.  
  167. procedure TSwitch.KeyDown(var Key: Word; Shift: TShiftState);
  168. begin
  169.   if Focused and ((Key = VK_Space) or (Key = VK_Return)) then
  170.   begin
  171.     FChecked:=not FChecked;
  172.     CallNotifyEvent;
  173.     Invalidate;
  174.     Click;
  175.   end;
  176. end;
  177. {------------------------------------------------------------------------------}
  178.  
  179. procedure TSwitch.CallNotifyEvent;                       {Au-enwelt informieren}
  180. begin
  181.   if Assigned(FOnChanged) then FOnChanged(Self);
  182.   if FChecked and Assigned(FOnChecked) then FOnChecked(Self) else
  183.   if not FChecked and Assigned(FOnUnChecked) then FOnUnChecked(Self);
  184. end;
  185. {------------------------------------------------------------------------------}
  186.  
  187. procedure TSwitch.Draw;                                      {Schalter zeichnen}
  188. var
  189.   TW: Integer;
  190.   TH: Integer;
  191. begin
  192.   Setup;                                  {Vektoren fnr Schalterteile berechnen}
  193.   if Focused then Canvas.Rectangle(0,0,Width,AHeight + 1 + 2 * ATop);
  194.   Canvas.Pen.Color:=clWhite;                   {Umrandung von Schalter zeichnen}
  195.   Canvas.MoveTo(ALeft - 1,ATop + AHeight + 1);
  196.   Canvas.LineTo(ALeft + AWidth,ATop + AHeight + 1);      {Untere Linie in weiss}
  197.   Canvas.LineTo(ALeft + AWidth,ATop - 2);                {Rechte Linie in weiss}
  198.  
  199.   Canvas.Pen.Color:=clGray;
  200.   Canvas.MoveTo(ALeft + AWidth,ATop - 1);
  201.   Canvas.LineTo(ALeft - 1,ATop - 1);                 {Obere Linie in dunkelgrau}
  202.   Canvas.LineTo(ALeft - 1,ATop + AHeight + 1);       {Linke Linie in dunkelgrau}
  203.  
  204.   Canvas.Pen.Color:=clBlack;                      {Polygonumrandung ist schwarz}
  205.   Canvas.Brush.Style:=bsSolid;                      {Fnllfl_che ist geschlossen}
  206.   Setup;
  207.   Canvas.Brush.Color:=FTopColor;
  208.   Canvas.Polygon(TopShape);                         {Top des Schalters zeichnen}
  209.   Canvas.Brush.Color:=FSideColor;
  210.   Canvas.Polygon(SideShape);                      {Seite des Schalters zeichnen}
  211.   if FChecked then Canvas.Brush.Color:=FOnColor
  212.   else Canvas.Brush.Color:=FOffColor;
  213.   Canvas.Polygon(OnShape);                     {On Seite des Schalters zeichnen}
  214.   Canvas.Brush.Color:=FOffColor;
  215.   Canvas.Polygon(OffShape);                   {Off Seite des Schalters zeichnen}
  216.  
  217.   Canvas.Font:=Font;                                  {Gew_hlten Font nbergeben}
  218.   Canvas.Brush.Style:=bsClear;                        {Transparente Textausgabe}
  219.  
  220.   if FChecked then Caption:=FCaptionOn else Caption:=FCaptionOff;
  221.  
  222.   if LabelLen > 0 then TW:=ALeft + ((Abs(LabelLen) - Canvas.TextWidth(Caption)) div 2)
  223.   else TW:=LabelOfs + ((Abs(LabelLen) - Canvas.TextWidth(Caption)) div 2);
  224.   TH:=ATop + ((AHeight - Canvas.TextHeight(Caption)) div 2);
  225.  
  226.   Canvas.TextOut(TW,TH,Caption);
  227. end;
  228. {------------------------------------------------------------------------------}
  229.  
  230. procedure TSwitch.Setup;                  {Vektoren fnr Schalterteile berechnen}
  231. begin
  232.   ALeft:=2;                {2 Pixel linker Abstand fnr Rahmen und Focusrechteck}
  233.   ATop:=2;                 {2 Pixel oberer Abstand fnr Rahmen und Focusrechteck}
  234.   AHeight:=Height - FSlope - 2 * ATop;   {Schalterhwhe = Height - Ofs - Neigung}
  235.   AWidth:=Width - 2 * ALeft;                  {Schalterbreite = Width - 2 * Ofs}
  236.   LabelLen:=AWidth div 2;
  237.   LabelOfs:=LabelLen + ALeft;
  238.   Side:=FSideLength;
  239.   if (not FChecked and FCheckedLeft) or (not FCheckedLeft and FChecked) then
  240.   begin
  241.     LabelLen:=-LabelLen;
  242.     Side:=-FSideLength;
  243.   end;
  244.   TopShape[0].X:=LabelOfs;          {Vektoren von obere Dreieckfl_che berechnen}
  245.   TopShape[0].Y:=ATop;
  246.   TopShape[1].X:=LabelOfs + LabelLen - Side;
  247.   TopShape[1].Y:=ATop + FSlope;
  248.   TopShape[2].X:=LabelOfs + LabelLen;
  249.   TopShape[2].Y:=ATop;
  250.  
  251.   OnShape[0].X:=LabelOfs - LabelLen;   {Vektoren der "EIN" Frontseite berechnen}
  252.   OnShape[0].Y:=ATop;
  253.   OnShape[1]:=TopShape[0];
  254.   OnShape[2]:=OffShape[3];
  255.   OnShape[3].X:=OnShape[0].X;
  256.   OnShape[3].Y:=ATop + AHeight;
  257.  
  258.   OffShape[0]:=TopShape[0];            {Vektoren der "AUS" Frontseite berechnen}
  259.   OffShape[1]:=TopShape[1];
  260.   OffShape[2].X:=OffShape[1].X;
  261.   OffShape[2].Y:=OffShape[1].Y + AHeight;
  262.   OffShape[3].X:=OffShape[0].X;
  263.   OffShape[3].Y:=ATop + AHeight;
  264.  
  265.   SideShape[0]:=OffShape[1];               {Vektoren der Seitenfl_che berechnen}
  266.   SideShape[1]:=TopShape[2];
  267.   SideShape[2].X:=SideShape[1].X;
  268.   SideShape[2].Y:=ATop + AHeight;
  269.   SideShape[3]:=OffShape[2];
  270. end;
  271. {------------------------------------------------------------------------------}
  272.  
  273. procedure TSwitch.SetCaptionOn(Value: TCaption);   {Beschriftung "ON" nbergeben}
  274. begin
  275.   if FCaptionOn <> Value then
  276.   begin
  277.     FCaptionOn:=Value;
  278.     Invalidate;
  279.   end;
  280. end;
  281. {------------------------------------------------------------------------------}
  282.  
  283. procedure TSwitch.SetCaptionOff(Value: TCaption); {Beschriftung "OFF" nbergeben}
  284. begin
  285.   if FCaptionOff <> Value then
  286.   begin
  287.     FCaptionOff:=Value;
  288.     Invalidate;
  289.   end;
  290. end;
  291. {------------------------------------------------------------------------------}
  292.  
  293. procedure TSwitch.SetChecked(Value: Boolean);
  294. begin
  295.   if FChecked <> Value then
  296.   begin
  297.     FChecked:=Value;
  298.     CallNotifyEvent;
  299.     Invalidate;
  300.   end;
  301. end;
  302. {------------------------------------------------------------------------------}
  303.  
  304. procedure TSwitch.SetCheckedLeft(Value: Boolean);
  305. begin
  306.   if FCheckedLeft <> Value then
  307.   begin
  308.     FCheckedLeft:=Value;
  309.     Invalidate;
  310.   end;
  311. end;
  312. {------------------------------------------------------------------------------}
  313.  
  314. procedure TSwitch.SetSlope(Value: Byte);
  315. begin
  316.   if FSlope <> Value then
  317.   begin
  318.     FSlope:=Value;
  319.     Invalidate;
  320.   end;
  321. end;
  322. {------------------------------------------------------------------------------}
  323.  
  324. procedure TSwitch.SetSideLength(Value: Byte);
  325. begin
  326.   if (FSideLength <> Value) and (Value < Width - 4) then
  327.   begin
  328.     FSideLength:=Value;
  329.     Invalidate;
  330.   end;
  331. end;
  332. {------------------------------------------------------------------------------}
  333.  
  334. procedure TSwitch.SetOnColor(Value: TColor);
  335. begin
  336.   if FOnColor <> Value then
  337.   begin
  338.     FOnColor:=Value;
  339.     Invalidate;
  340.   end;
  341. end;
  342. {------------------------------------------------------------------------------}
  343.  
  344. procedure TSwitch.SetOffColor(Value: TColor);
  345. begin
  346.   if FOffColor <> Value then
  347.   begin
  348.     FOffColor:=Value;
  349.     Invalidate;
  350.   end;
  351. end;
  352. {------------------------------------------------------------------------------}
  353.  
  354. procedure TSwitch.SetTopColor(Value: TColor);
  355. begin
  356.   if FTopColor <> Value then
  357.   begin
  358.     FTopColor:=Value;
  359.     Invalidate;
  360.   end;
  361. end;
  362. {------------------------------------------------------------------------------}
  363.  
  364. procedure TSwitch.SetSideColor(Value: TColor);
  365. begin
  366.   if FSideColor <> Value then
  367.   begin
  368.     FSideColor:=Value;
  369.     Invalidate;
  370.   end;
  371. end;
  372. {------------------------------------------------------------------------------}
  373.  
  374. procedure Register;
  375. begin
  376.   RegisterComponents('Udo|s',[TSwitch]);
  377. end;
  378. {------------------------------------------------------------------------------}
  379.  
  380. initialization
  381. end.
  382.  
  383.